home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 004 / count2.arc / COUNT2.PAS
Encoding:
Pascal/Delphi Source File  |  1985-10-05  |  2.6 KB  |  97 lines
  1. program COUNT ;
  2. {This is a counting program for small children that uses screen control.
  3.  It was written for TURBO pascal.
  4.  Revision  1.0     3-22-85          Mike Secord}
  5. {$I-}
  6. const
  7.   num = 14 ; {this sets the maximum number of items to count 14 is prog max}
  8. var
  9. i, j, k, l, n: integer ;
  10. flag, ok: boolean ;
  11. done: string[1] ;
  12. procedure drawbox(x1,y1,x2,y2: integer) ;
  13. var
  14.   i: integer ;
  15.   begin
  16.     gotoxy(x1,y1) ;
  17.     lowvideo ;
  18.     for i := x1 to x2 do write(' ') ;
  19.     gotoxy(x1,y1+1) ;
  20.     for i := y1+1 to y2 do
  21.     begin
  22.         gotoxy(x1,i) ; write(' ') ;
  23.         gotoxy(x2,i) ; write(' ') ;
  24.     end ;
  25.     gotoxy(x1,y2) ;
  26.     for i := x1 to x2 do write(' ') ;
  27.   end; {of procedure drawbox}
  28.  
  29. procedure face (x1,y1: integer; happy: boolean) ;
  30. {x1 and y1 are the upper left hand corner of the box containing the face}
  31. var
  32.   i : integer ;
  33.   begin
  34.     gotoxy(x1,y1) ;    writeln('    *****    ') ;
  35.     gotoxy(x1,y1+1) ;  writeln(' *  o   o  * ') ;
  36.     gotoxy(x1,y1+2) ;  writeln('*     ^     *') ;
  37.     gotoxy(x1,y1+3) ;
  38.     if happy = true then writeln(' *  |___|  * ') ;
  39.     if happy = false then writeln(' *  .---.  * ') ;
  40.     gotoxy(x1,y1+4) ;  writeln('    *****    ') ;
  41.   end;{of face procedure}
  42.  
  43. begin  {main program}
  44. clrscr ;
  45. gotoxy(20,12) ;
  46. write('C O U N T   T H E    I T E M S    G A M E    ') ;
  47. delay(3000) ;
  48. repeat
  49.   clrscr ;
  50.   flag := true ;
  51.   highvideo ;
  52.   for j := 1 to 5 do
  53.     begin
  54.       drawbox(20, 4, 60, 12 ) ;
  55.       highvideo ;
  56.       gotoxy(21,7) ;
  57.       write('                                      ') ;
  58.       gotoxy(21,9) ;
  59.       write('                                      ') ;
  60.       randomize ;
  61.       for i:= 1 to random(num)+1  do
  62.         begin
  63.           if i > 7  then
  64.           begin
  65.              gotoxy(20+5*(i-7),9) ;
  66.              write('##') ;
  67.           end ;
  68.           if i< 8 then
  69.           begin
  70.             gotoxy(20+5*i, 7) ;
  71.             write('##') ;
  72.           end ;
  73.         end ;
  74.       repeat
  75.          gotoxy(45,15) ;
  76.          write('HOW MANY ITEMS IN THE BOX ?         ',^H,^H,^H,^H,^H,^H,^H) ;
  77.          read(k) ;
  78.          ok := (ioresult = 0) ;
  79.          if not ok then write(^G) ;
  80.       until ok ;
  81.       if k = i then flag:=true
  82.       else flag := false ;
  83.       lowvideo ;
  84.       if j = 1 then face(1,19,flag)
  85.       else face((j-1)*15, 19, flag) ;
  86.     end;
  87.     highvideo ;
  88.     repeat
  89.        writeln ;
  90.        write('WOULD YOU LIKE TO PLAY AGAIN (Y or N) ? ') ;
  91.        readln(done) ;
  92.        ok := (ioresult = 0) ;
  93.        if not ok then write(^G) ;
  94.     until ok ;
  95.   until (done = 'n') or (done = 'N') ;
  96. end.
  97.